home *** CD-ROM | disk | FTP | other *** search
/ Web Page Construction Kit 3.0 / Web Page Construction Kit 3.0.iso / pc / source / 3rdparty / cgi / libs / cgilibpl / cgi-lib.pl
Encoding:
Perl Script  |  1995-12-08  |  5.1 KB  |  207 lines
  1. #!/usr/local/bin/perl -- -*- C -*-
  2.  
  3. # Perl Routines to Manipulate CGI input
  4. # S.E.Brenner@bioc.cam.ac.uk
  5. # $Header: /cys/people/brenner/http/cgi-bin/RCS/cgi-lib.pl,v 1.14 1995/10/25 15:08:37 brenner Exp $
  6. #
  7. # Copyright (c) 1995 Steven E. Brenner  
  8. # Unpublished work.
  9. # Permission granted to use and modify this library so long as the
  10. # copyright above is maintained, modifications are documented, and
  11. # credit is given for any use of the library.
  12. #
  13. # Thanks are due to many people for reporting bugs and suggestions
  14. # especially Meng Weng Wong, Maki Watanabe, Bo Frese Rasmussen,
  15. # Andrew Dalke, Mark-Jason Dominus, Dave Dittrich, Jason Mathews
  16.  
  17. # For more information, see:
  18. #     http://www.bio.cam.ac.uk/web/form.html       
  19. #     http://www.seas.upenn.edu/~mengwong/forms/   
  20.  
  21. # Minimalist http form and script (http://www.bio.cam.ac.uk/web/minimal.cgi):
  22. #
  23. # require "cgi-lib.pl";
  24. # if (&ReadParse(*input)) {
  25. #    print &PrintHeader, &PrintVariables(%input);
  26. # } else {
  27. #   print &PrintHeader,'<form><input type="submit">Data: <input name="myfield">';
  28. #}
  29.  
  30. # ReadParse
  31. # Reads in GET or POST data, converts it to unescaped text, and puts
  32. # one key=value in each member of the list "@in"
  33. # Also creates key/value pairs in %in, using '\0' to separate multiple
  34. # selections
  35.  
  36. # Returns TRUE if there was input, FALSE if there was no input 
  37. # UNDEF may be used in the future to indicate some failure.
  38.  
  39. # Now that cgi scripts can be put in the normal file space, it is useful
  40. # to combine both the form and the script in one place.  If no parameters
  41. # are given (i.e., ReadParse returns FALSE), then a form could be output.
  42.  
  43. # If a variable-glob parameter (e.g., *cgi_input) is passed to ReadParse,
  44. # information is stored there, rather than in $in, @in, and %in.
  45.  
  46. sub ReadParse {
  47.   local (*in) = @_ if @_;
  48.   local ($i, $key, $val);
  49.  
  50.   # Read in text
  51.   if (&MethGet) {
  52.     $in = $ENV{'QUERY_STRING'};
  53.   } elsif (&MethPost) {
  54.     read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
  55.   }
  56.  
  57.   @in = split(/[&;]/,$in); 
  58.  
  59.   foreach $i (0 .. $#in) {
  60.     # Convert plus's to spaces
  61.     $in[$i] =~ s/\+/ /g;
  62.  
  63.     # Split into key and value.  
  64.     ($key, $val) = split(/=/,$in[$i],2); # splits on the first =.
  65.  
  66.     # Convert %XX from hex numbers to alphanumeric
  67.     $key =~ s/%(..)/pack("c",hex($1))/ge;
  68.     $val =~ s/%(..)/pack("c",hex($1))/ge;
  69.  
  70.     # Associate key and value
  71.     $in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator
  72.     $in{$key} .= $val;
  73.  
  74.   }
  75.  
  76.   return scalar(@in); 
  77. }
  78.  
  79.  
  80. # PrintHeader
  81. # Returns the magic line which tells WWW that we're an HTML document
  82.  
  83. sub PrintHeader {
  84.   return "Content-type: text/html\n\n";
  85. }
  86.  
  87.  
  88. # HtmlTop
  89. # Returns the <head> of a document and the beginning of the body
  90. # with the title and a body <h1> header as specified by the parameter
  91.  
  92. sub HtmlTop
  93. {
  94.   local ($title) = @_;
  95.  
  96.   return <<END_OF_TEXT;
  97. <html>
  98. <head>
  99. <title>$title</title>
  100. </head>
  101. <body>
  102. <h1>$title</h1>
  103. END_OF_TEXT
  104. }
  105.  
  106. # Html Bot
  107. # Returns the </body>, </html> codes for the bottom of every HTML page
  108.  
  109. sub HtmlBot
  110. {
  111.    return "</body>\n</html>\n";
  112.  }
  113.  
  114.  
  115. # MethGet
  116. # Return true if this cgi call was using the GET request, false otherwise
  117.  
  118. sub MethGet {
  119.   return ($ENV{'REQUEST_METHOD'} eq "GET");
  120. }
  121.  
  122.  
  123. # MethPost
  124. # Return true if this cgi call was using the POST request, false otherwise
  125.  
  126. sub MethPost {
  127.   return ($ENV{'REQUEST_METHOD'} eq "POST");
  128. }
  129.  
  130.  
  131. # MyURL
  132. # Returns a URL to the script
  133.  
  134. sub MyURL  {
  135.   local ($port);
  136.   $port = ":" . $ENV{'SERVER_PORT'} if  $ENV{'SERVER_PORT'} != 80;
  137.   return  'http://' . $ENV{'SERVER_NAME'} .  $port . $ENV{'SCRIPT_NAME'};
  138. }
  139.  
  140.  
  141. # CgiError
  142. # Prints out an error message which which containes appropriate headers,
  143. # markup, etcetera.
  144. # Parameters:
  145. #  If no parameters, gives a generic error message
  146. #  Otherwise, the first parameter will be the title and the rest will 
  147. #  be given as different paragraphs of the body
  148.  
  149. sub CgiError {
  150.   local (@msg) = @_;
  151.   local ($i,$name);
  152.  
  153.   if (!@msg) {
  154.     $name = &MyURL;
  155.     @msg = ("Error: script $name encountered fatal error");
  156.   };
  157.  
  158.   print &PrintHeader;
  159.   print "<html><head><title>$msg[0]</title></head>\n";
  160.   print "<body><h1>$msg[0]</h1>\n";
  161.   foreach $i (1 .. $#msg) {
  162.     print "<p>$msg[$i]</p>\n";
  163.   }
  164.   print "</body></html>\n";
  165. }
  166.  
  167.  
  168. # CgiDie
  169. # Identical to CgiError, but also quits with the passed error message.
  170.  
  171. sub CgiDie {
  172.   local (@msg) = @_;
  173.   &CgiError (@msg);
  174.   die @msg;
  175. }
  176.  
  177.  
  178. # PrintVariables
  179. # Nicely formats variables in an associative array passed as a parameter
  180. # And returns the HTML string.
  181. sub PrintVariables {
  182.   local (%in) = @_;
  183.   local ($old, $out, $output);
  184.   $old = $*;  $* =1;
  185.   $output .=  "\n<dl compact>\n";
  186.   foreach $key (sort keys(%in)) {
  187.     foreach (split("\0", $in{$key})) {
  188.       ($out = $_) =~ s/\n/<br>\n/g;
  189.       $output .=  "<dt><b>$key</b>\n <dd><i>$out</i><br>\n";
  190.     }
  191.   }
  192.   $output .=  "</dl>\n";
  193.   $* = $old;
  194.  
  195.   return $output;
  196. }
  197.  
  198. # PrintVariablesShort
  199. # Now obsolete; just calls PrintVariables
  200.  
  201. sub PrintVariablesShort {
  202.   return &PrintVariables(@_);
  203. }
  204.  
  205. 1; #return true 
  206.  
  207.